home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / stkchart.arc / SMADDEL2.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-11-20  |  24.7 KB  |  691 lines
  1. 10000  'SMADDEL2 - STOCK CHARTING SYSTEM INDEX FILE MAINTENANCE - RELEASE 2.1
  2. 10130  SCREEN 0,0,0:COLOR 7,0:WIDTH 80:DEFINT A-Z:OPTION BASE 0
  3. 10140  KEY OFF:FOR J=1 TO 10:KEY J,"":NEXT J:CLS:Z$=MKI$(0):C$=Z$
  4. 10150  H$="SMADDEL2.HS1":W$=SPACE$(80):D$=SPACE$(64)
  5. 10160  PD$=SPACE$(32):XD$=SPACE$(64)
  6. 10170  FOR K=35 TO 63 STEP 2:MID$(XD$,K,2)=MKI$(0):NEXT K
  7. 10180  TM=90:XM=111:DIM XN(111),XL(111),XR$(111)
  8. 10190  FOR J=0 TO XM:XR$(J)=XD$:NEXT J
  9. 10240  DIM MT(12):FOR J=1 TO 12:READ MT(J):NEXT J
  10. 10250  DATA 31,28,31,30,31,30,31,31,30,31,30,31
  11. 10260  DC$=DATE$:DY=VAL(RIGHT$(DC$,4))-1920:DM=VAL(LEFT$(DC$,2))
  12. 10270  DD=VAL(MID$(DC$,4,2)):MT(2)=28+ABS(DY MOD 4 = 0):J=DM:DJ=DD
  13. 10280  IF J>1 THEN J=J-1:DJ=DJ+MT(J):GOTO 10280
  14. 10290  DW=(INT((DY-1)*365.25)+DJ+5) MOD 7:IF DW=0 THEN DW=7
  15. 10330  DIM BS(22):FOR J=1 TO 22:READ BS(J):NEXT J
  16. 10340  DATA &H8B55,&HB8EC,&H0600,&H07B7,&H768B,&H8A0C,&H8B2C
  17. 10350  DATA &H0A76,&H0C8A,&H768B,&H8A08,&H8B34,&H0676,&H148A
  18. 10360  DATA &HCDFE,&HC9FE,&HCEFE,&HCAFE,&H10CD,&HCA5D,&H0008,&H0000
  19. 10450  DIM SC(33):FOR J=1 TO 33:READ SC(J):NEXT J
  20. 10460  DATA &H8B55,&H50EC,&H5153,&H5652,&HB68B,&H0010,&H2C8A,&HB68B
  21. 10470  DATA &H000E,&H0C8A,&HB68B,&H000C,&H348A,&HB68B,&H000A,&H148A
  22. 10480  DATA &HB68B,&H0008,&H3C8A,&HB68B,&H0006,&H048A,&HCDFE,&HC9FE
  23. 10490  DATA &HCEFE,&HCAFE,&H06B4,&H10CD,&H5A5E,&H5B59,&H5D58,&H0CCA,&H0000
  24. 10640  OPEN"SMSETUP2.CTL" AS #1 LEN=64:IF LOF(1)<=0 THEN 10670
  25. 10650  FIELD#1,64 AS B$:GET#1:IF LEFT$(B$,4)<>"SMC2" THEN 10670
  26. 10660  LSET D$=B$:CLOSE#1:IF MID$(D$,11,1)="Y" THEN 12830 ELSE 10740
  27. 10670  MID$(D$,1)="SMC2":MID$(D$,5)=MKI$(64)
  28. 10680  MID$(D$,7)=MKI$(1):MID$(D$,9)=MKI$(1):MID$(D$,11)="NB2"
  29. 10690  CLOSE#1:KILL"SMSETUP2.CTL"
  30. 10740  LOCATE 3,18,0:PRINT"U S E R - S U P P O R T E D   S O F T W A R E";
  31. 10750  LOCATE 5,1
  32. 10760  PRINT"If you are using these programs and find";
  33. 10770  PRINT" them to be of value, please send $25"
  34. 10780  PRINT"directly to the author (Calif. residents";
  35. 10790  PRINT" please include appropriate sales tax)."
  36. 10800  PRINT"This will make you a registered owner, a";
  37. 10810  PRINT"nd you will be notified of later ver-"
  38. 10820  PRINT"sions of this and other related software";
  39. 10830  PRINT" as they are released.  You will also"
  40. 10840  PRINT"receive additional printed documentation";
  41. 10850  PRINT" on installing and using your program."
  42. 10860  LOCATE 11,1
  43. 10870  PRINT"You are encouraged to copy and share the";
  44. 10880  PRINT"se programs.  Suggestions and comments"
  45. 10890  PRINT"are welcome, and may be addressed direct";
  46. 10900  PRINT"ly to the author.  Thank you.";
  47. 10910  LOCATE 14,14
  48. 10920  PRINT"This is an original stock charting system written by:";
  49. 10930  LOCATE 16,33:PRINT"Charles L. Pack";
  50. 10940  LOCATE 17,31:PRINT"25303 La Loma Drive";
  51. 10950  LOCATE 18,27:PRINT"Los Altos Hills, Ca.  94022";
  52. 11010  LOCATE 20,1
  53. 11020  PRINT"If you have not used these programs befo";
  54. 11030  PRINT"re, please read the Help screens as you"
  55. 11040  PRINT"go along.  Press the letter H (for Help)";
  56. 11050  PRINT" to get the first directions on how to"
  57. 11060  PRINT"use the programs.  Press the ENTER or Es";
  58. 11070  PRINT"c key to start running the programs.";
  59. 11080  H=CSRLIN:G=POS(0)
  60. 11110  LOCATE H,G,1:GOSUB 29650:IF ESC THEN 11240
  61. 11120  IF LEFT$(C$,1)=CHR$(13) THEN 11240
  62. 11130  IF LEFT$(C$,1)="h" OR LEFT$(C$,1)="H" THEN 11160
  63. 11140  GOSUB 29830:GOTO 11110
  64. 11160  H1=20:H2=24:G1=1:G2=80:GOSUB 29740
  65. 11170  MID$(W$,79)=MID$(D$,12,2):MID$(D$,12)=" "
  66. 11180  F=1:GOSUB 14060:MID$(D$,12)=MID$(W$,79,2)
  67. 11190  IF F>=0 THEN 11010 ELSE CLS:GOTO 11010
  68. 11230  GOSUB 29730:GOSUB 26240:IF ESC THEN 13030
  69. 11240  MID$(W$,79)=MID$(D$,12,2)
  70. 11250  CLS:PRINT"DISK DRIVE OPTIONS: (Note - programs are";
  71. 11260  PRINT" always on the system (default) drive).";
  72. 11310  LOCATE 3,1
  73. 11320  PRINT"A. Only one floppy disk drive is availab";
  74. 11330  PRINT"le (PC Jr., etc.).  Data will be expec-"
  75. 11340  PRINT"   ted on a different diskette from the ";
  76. 11350  PRINT"program diskette (the program will tell"
  77. 11360  PRINT"   you which diskette it wants).  Howeve";
  78. 11370  PRINT"r, if you are charting only a few"
  79. 11380  PRINT"   securities, you could also select opt";
  80. 11390  PRINT"ion C below.";
  81. 11410  LOCATE 8,1
  82. 11420  PRINT"B. Two (or more) floppy disk drives are ";
  83. 11430  PRINT"available.  Data and programs will be"
  84. 11440  PRINT"   expected on separate drives, but you ";
  85. 11450  PRINT"can have any number of different data"
  86. 11460  PRINT"   disks.  Programs can also be on a har";
  87. 11470  PRINT"d disk with data on floppies.  Data for"
  88. 11480  PRINT"   a few securities can also be stored o";
  89. 11490  PRINT"n a program diskette; see below.";
  90. 11510  LOCATE 13,1
  91. 11520  PRINT"C: A hard disk drive is to be used.  Pro";
  92. 11530  PRINT"grams and data are both to be on the"
  93. 11540  PRINT"   hard disk (a separate sub-directory i";
  94. 11550  PRINT"s recommended).  This option can also"
  95. 11560  PRINT"   be used with a floppy diskette, with ";
  96. 11570  PRINT"both data and programs stored together,"
  97. 11580  PRINT"   but data storage space will be somewh";
  98. 11590  PRINT"at limited.";
  99. 11610  LOCATE 19,1
  100. 11620  PRINT"THE CURRENTLY SELECTED OPTIONS ARE:";
  101. 11630  LOCATE 21,1
  102. 11640  PRINT"Disk drive option (see above): Option ";
  103. 11650  IF MID$(D$,12,1)=" " THEN PRINT"C.";:GOTO 11680
  104. 11660  IF MID$(D$,12,1)="*" THEN PRINT"A.";:GOTO 11680
  105. 11670  PRINT"B with data on drive ";MID$(D$,12,1);".";
  106. 11680  LOCATE 22,1
  107. 11690  PRINT"Disk operating system (IBM DOS or MS-DOS): Version ";
  108. 11700  PRINT MID$(D$,13,1);".";
  109. 11770  LOCATE 24,1
  110. 11780  PRINT"Are the currently selected options correct";
  111. 11790  GOSUB 29550:IF ESC OR YES THEN 12630
  112. 12030  H1=18:H2=24:G1=1:G2=80:GOSUB 29740
  113. 12040  LOCATE 22,1
  114. 12050  PRINT"WARNING: An incorrect option specificati";
  115. 12060  PRINT"on could cause the program to operate"
  116. 12070  PRINT"incorrectly or even terminate abnormally";
  117. 12080  PRINT", and you may have to re-start the"
  118. 12090  PRINT"stock charting system all over again.";
  119. 12110  LOCATE 20,1:PRINT"Specify disk drive option A, B or C (see above):";
  120. 12120  LOCATE 20,49,1:GOSUB 29660:IF NOT ESC THEN 12140
  121. 12130  H1=18:H2=24:G1=1:G2=80:GOSUB 29740:GOTO 11610
  122. 12140  IF LEFT$(C$,1)>=CHR$(96) THEN MID$(C$,1,1)=CHR$(ASC(LEFT$(C$,1))-32)
  123. 12150  IF LEFT$(C$,1)="C" THEN MID$(W$,77)=" ":GOTO 12350
  124. 12160  IF LEFT$(C$,1)="A" THEN MID$(W$,77)="*":GOTO 12350
  125. 12170  IF LEFT$(C$,1)<>"B" THEN GOSUB 29830:GOTO 12120
  126. 12210  LOCATE 20,1:PRINT SPACE$(79);
  127. 12220  LOCATE 20,1:PRINT"Enter drive specifier (A-Z) for data disk:";
  128. 12230  LOCATE 20,43,1:GOSUB 29660:IF NOT ESC THEN 12250
  129. 12240  H1=18:H2=24:G1=1:G2=80:GOSUB 29740:GOTO 11610
  130. 12250  IF LEFT$(C$,1)>=CHR$(96) THEN MID$(C$,1,1)=CHR$(ASC(LEFT$(C$,1))-32)
  131. 12260  IF LEFT$(C$,1)<"A" OR LEFT$(C$,1)>"Z" THEN GOSUB 29830:GOTO 12230
  132. 12270  MID$(W$,77)=LEFT$(C$,1)
  133. 12350  CLS:LOCATE 20,1:MID$(W$,78)="2"
  134. 12360  PRINT"Are you using IBM DOS or MS-DOS Version 1";
  135. 12370  GOSUB 29550:IF ESC THEN 11250
  136. 12380  IF YES THEN MID$(W$,78)="1"
  137. 12390  MID$(D$,12)=MID$(W$,77,2):GOTO 11250
  138. 12630  CLS:IF MID$(D$,11,1)<>"Y" THEN 12740
  139. 12640  IF MID$(D$,12,2)<>MID$(W$,79,2) THEN 12660
  140. 12650  GOSUB 25240:GOSUB 25050:GOTO 13030
  141. 12660  IF MID$(D$,12,1)<>"*" THEN 12740
  142. 12670  LOCATE 23,1:PRINT"Insert PROGRAM diskette and press ENTER.";
  143. 12680  GOSUB 29250:IF ESC THEN GOSUB 29830:GOTO 12680
  144. 12740  ON ERROR GOTO 12780
  145. 12750  OPEN"SMSETUP2.CTL"AS #1 LEN=64:ON ERROR GOTO 29930
  146. 12760  FIELD#1,64 AS B$:MID$(D$,11)="Y":LSET B$=D$
  147. 12770  PUT#1:CLOSE#1:GOTO 12830
  148. 12780  IF ERR=71 THEN RESUME 12790 ELSE 29930
  149. 12790  ON ERROR GOTO 29930:GOSUB 29040:GOTO 12740
  150. 12830  GOSUB 25240:LSET XD$=XR$(0)
  151. 12840  FOR J=1 TO XM:LSET XR$(J)=XD$:XN(J)=0:XL(J)=0:NEXT J
  152. 12850  IF MID$(D$,12,1)<>"*" THEN 12910
  153. 12860  LOCATE 23,1:PRINT"Insert DATA disk and press ENTER or Esc when ready.";
  154. 12870  GOSUB 29250:IF ESC THEN MID$(D$,11)="N":GOTO 11240
  155. 12910  GOSUB 26640:IF ESC THEN MID$(D$,11)="N":GOTO 11240
  156. 12920  ON SGN(XC)+2 GOTO 12940,12930,12990
  157. 12930  XF=0:XT=0:GOTO 12980
  158. 12940  LOCATE 23,1:PRINT"Index not found on data disk.";
  159. 12950  PRINT"  Do you want to start a new one";
  160. 12960  GOSUB 29550:IF NOT YES THEN GOSUB 29140:GOTO 12910
  161. 12970  GOSUB 29730:XT=0:XC=0:XF=0:X4=0:X5=0:X6=0:GOSUB 26440
  162. 12980  X2=X1:X3=X2-1:GOSUB 15260:GOTO 13030
  163. 12990  XF=1:XT=XC:GOSUB 25050:X2=X1+X5-X4:X=2
  164. 13030  LOCATE 21,1
  165. 13040  PRINT"The ";CHR$(24);" ";CHR$(25);" ";CHR$(26);" ";CHR$(27);" Home ";
  166. 13050  PRINT"End PgUp PgDn keys are used to select a stock or a data item.  ";
  167. 13060  PRINT"A=Add a new stock   D=Delete selected stock";
  168. 13070  PRINT"  C=Change  G=Graph  S=Setup  Q=Quit ";
  169. 13080  PRINT"R=Re-insert the most recently deleted stock";
  170. 13090  PRINT"  E=Enter volume and prices   H=Help ";
  171. 13100  PRINT"Press appropriate key for required function.";SPACE$(35);
  172. 13110  GOSUB 25360
  173. 13120  LOCATE 24,45,1:GOSUB 29650
  174. 13130  IF LEFT$(C$,1)=CHR$(0) THEN 13170
  175. 13140  F=INSTR(1,"24681379aAcCdDeEgGhHqQrRsS",LEFT$(C$,1))
  176. 13150  IF F<=0 THEN GOSUB 29830:GOTO 13120
  177. 13160  IF F<=8 THEN 13230 ELSE 13260
  178. 13170  F=INSTR(1,"PKMHOQGI",RIGHT$(C$,1))
  179. 13180  IF F<=0 THEN GOSUB 29830:GOTO 13120
  180. 13230  GOSUB 25320:IF XF=0 THEN GOSUB 29850:GOTO 13110
  181. 13240  ON F GOSUB 24510,24140,24040,24310,24930,24740,24830,24640
  182. 13250  GOTO 13110
  183. 13260  F=(F-7)\2:IF F>8 THEN 11230
  184. 13270  ON F GOSUB 15260,16570,14560,13830,13830,14050,13530,15050
  185. 13280  ON SGN(F)+2 GOTO 13290,13030,13110
  186. 13290  GOSUB 25240:GOSUB 25050:GOTO 13030
  187. 13530  GOSUB 25320:GOSUB 29730:LOCATE 22,1
  188. 13540  PRINT"Do you want to quit the stock charting system and go to DOS";
  189. 13550  GOSUB 29550:IF ESC OR NOT YES THEN F=0:RETURN
  190. 13560  GOSUB 29730:GOSUB 26240:IF ESC THEN F=0:RETURN
  191. 13570  IF MID$(D$,12,1)<>"*" THEN 13610
  192. 13580  LOCATE 23,1:PRINT"Insert PROGRAM diskette and press ENTER.";
  193. 13590  GOSUB 29250:IF ESC THEN F=0:RETURN
  194. 13610  MID$(D$,11)="N":ON ERROR GOTO 13640
  195. 13620  OPEN"SMSETUP2.CTL" AS #1 LEN=64:ON ERROR GOTO 29930
  196. 13630  FIELD#1,64 AS B$:LSET B$=D$:PUT#1:CLOSE#1:GOTO 13660
  197. 13640  IF ERR=71 THEN RESUME 13650 ELSE 29930
  198. 13650  GOSUB 29040:IF ESC THEN F=0:RETURN ELSE 13610
  199. 13660  IF MID$(D$,12,1)<>"*" THEN 13690
  200. 13670  LOCATE 23,1:PRINT"Insert diskette with DOS on it and press ENTER.";
  201. 13680  GOSUB 29250
  202. 13690  CLS:SYSTEM
  203. 13830  GOSUB 25320:GOSUB 29730:LOCATE 22,1
  204. 13840  PRINT"Do you want to draw a graph or enter volume and prices";
  205. 13850  GOSUB 29550:IF ESC OR NOT YES THEN F=0:RETURN
  206. 13860  GOSUB 29730:GOSUB 26240:IF ESC THEN F=0:RETURN
  207. 13870  IF MID$(D$,12,1)<>"*" THEN 13960
  208. 13880  LOCATE 23,1:PRINT"Insert PROGRAM diskette and press ENTER.";
  209. 13890  GOSUB 29250:IF ESC THEN F=0:RETURN
  210. 13960  LOCATE 23,1:PRINT"One moment please, loading program ...  ";
  211. 13970  ON ERROR GOTO 13980:RUN"SMENTRY2"
  212. 13980  IF ERR=53 OR ERR=71 THEN RESUME 13990 ELSE 29930
  213. 13990  GOSUB 29040:GOTO 13960
  214. 14050  GOSUB 25320:LSET H$="SMADDEL2.HS2"
  215. 14060  GOSUB 29730:IF MID$(D$,12,1)<>"*" THEN 14110
  216. 14070  LOCATE 24,1:PRINT"Insert PROGRAM diskette and press ENTER,";
  217. 14080  PRINT" or press Esc to cancel Help screens.";
  218. 14090  GOSUB 29250:IF ESC THEN F=0:RETURN
  219. 14110  ON ERROR GOTO 14310:OPEN H$ FOR INPUT AS #1
  220. 14120  ON ERROR GOTO 29930:CLS:L=0
  221. 14130  IF EOF(1) THEN 14270
  222. 14140  LINE INPUT#1,B$:L=L+1:IF L<24 THEN PRINT B$:GOTO 14130
  223. 14150  PRINT"Press ENTER to see next Help screen, or E";
  224. 14160  PRINT"sc to cancel Help screen display.";
  225. 14170  GOSUB 29250:IF NOT ESC THEN CLS:L=1:PRINT B$:GOTO 14130
  226. 14180  CLOSE#1:F=-1:IF MID$(D$,12,1)<>"*" THEN RETURN
  227. 14190  CLS:LOCATE 24,1:PRINT"Insert DATA diskette";
  228. 14200  PRINT" and press ENTER or Esc key.";:GOSUB 29250:RETURN
  229. 14270  CLOSE#1:F=-1:LOCATE 24,1:IF MID$(D$,12,1)<>"*" THEN 14290
  230. 14280  PRINT"Insert DATA diskette.  ";
  231. 14290  GOSUB 29240:RETURN
  232. 14310  IF ERR=53 THEN RESUME 14340
  233. 14320  IF ERR=71 THEN RESUME 14330 ELSE 29930
  234. 14330  GOSUB 29040:IF ESC THEN F=0:RETURN ELSE 14110
  235. 14340  LOCATE 25,1:COLOR 23,0:PRINT"Help screen not available.";
  236. 14350  COLOR 7,0:BEEP:OK=0:F=0:LOCATE 23,1
  237. 14360  IF MID$(D$,12,1)<>"*" THEN RETURN
  238. 14370  PRINT"Insert PROGRAM diskette and press ENTER to try again,"
  239. 14380  PRINT"or insert DATA diskette and press Esc to cancel Help.";
  240. 14390  GOSUB 29250:IF ESC THEN RETURN ELSE 14110
  241. 14560  IF X5>0 OR X2<=X3 THEN 14590
  242. 14570  LOCATE 25,1:COLOR 23,0:PRINT"Can only Add or Re-Insert here.";
  243. 14580  COLOR 7,0:BEEP:OK=0:RETURN
  244. 14590  GOSUB 29730:LOCATE 21,1
  245. 14600  PRINT"WARNING - you are about to delete ALL pr";
  246. 14610  PRINT"ice history and other data for the"
  247. 14620  PRINT"security indicated by the selector block";
  248. 14630  PRINT".  (Data can be Restored for only the"
  249. 14640  PRINT"most recently deleted security, and only";
  250. 14650  PRINT" if the add/delete program has not been"
  251. 14660  PRINT"terminated.)  Verify if you wish to dele";
  252. 14670  PRINT"te this security";
  253. 14680  GOSUB 29550:IF ESC OR NOT YES THEN GOSUB 25320:F=0:RETURN
  254. 14690  GOSUB 29730:GOSUB 26240:XE=X5:IF XN(XF)<>XF THEN 14730
  255. 14710  XN(XE)=0:XL(XE)=0:X3=X2-1:X5=0:XF=0:XC=0
  256. 14720  LSET XD$=XR$(0):GOSUB 25180:GOTO 15260
  257. 14730  XN(XL(X5))=XN(X5):XL(XN(X5))=XL(X5):IF X4=XF THEN 14760
  258. 14740  IF XN(X6)=XF OR X3-X2>=X2-X1 THEN 14940
  259. 14750  IF X5=X6 THEN 14790 ELSE X5=XN(X5):GOTO 14810
  260. 14760  IF X5=XF THEN XF=XN(XF):X4=XF:X5=XF:GOTO 14810
  261. 14770  IF XN(X5)<>XF THEN IF X5=X6 THEN 14790 ELSE X5=XN(X5):GOTO 14810
  262. 14780  LSET XD$=XR$(0):GOSUB 25180:X5=XL(X5):X6=X5:X3=X3-1:X2=X3:GOTO 14990
  263. 14790  X5=XN(X5):X6=X5:LSET XD$=XR$(X6):Y=X3:GOSUB 25180:GOTO 14990
  264. 14810  H1=X2:H2=X3:G1=1:G2=80:Z=0:L=1
  265. 14820  SC(27)=&H6B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
  266. 14830  IF XN(X6)=XF THEN X3=X3-1:GOTO 14990
  267. 14840  X6=XN(X6):LSET XD$=XR$(X6):Y=X3:GOSUB 25180:GOTO 14990
  268. 14940  IF X4=X5 THEN 14980
  269. 14950  H1=X1:H2=X2:G1=1:G2=80:Z=0:L=1
  270. 14960  SC(27)=&H7B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
  271. 14970  IF X5=X6 THEN X6=XL(X6)
  272. 14980  X5=XL(X5):X4=XL(X4):LSET XD$=XR$(X4):Y=X1:GOSUB 25180
  273. 14990  XN(XE)=0:XL(XE)=0:XC=XC-1:F=0:RETURN
  274. 15050  IF XE>0 THEN 15080
  275. 15060  LOCATE 25,1:COLOR 23,0:PRINT"No Deleted entry to Re-insert.";
  276. 15070  COLOR 7,0:BEEP:OK=0:RETURN
  277. 15080  GOSUB 25320:IF XF<=0 OR X2=19 OR (X2>X3 AND X5=0) THEN 15180
  278. 15160  H1=X2:H2=19:G1=1:G2=80:Z=0:L=1
  279. 15170  SC(27)=&H7B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
  280. 15180  XA=XE:XE=0:LSET XD$=XR$(XA):GOSUB 25180
  281. 15190  GOSUB 16370:XC=XC+1:GOSUB 26440:RETURN
  282. 15260  XA=0:IF XT<XM THEN XA=XT+1:GOSUB 25320:GOTO 15310
  283. 15270  FOR J=1 TO XM:IF XN(J)<=0 AND XL(J)<=0 AND J<>XE THEN XA=J:J=XM
  284. 15280  NEXT J:IF XA>0 THEN GOSUB 25320:GOTO 15310
  285. 15290  LOCATE 25,1:COLOR 23,0:PRINT"Sorry, index is full!";
  286. 15300  COLOR 7,0:BEEP:OK=0:RETURN
  287. 15310  LSET XD$=XR$(0):IF XF<=0 OR (X2>X3 AND X5=0) THEN 15350
  288. 15320  IF X2=19 THEN GOSUB 25180:GOTO 15350
  289. 15330  H1=X2:H2=19:G1=1:G2=80:Z=0:L=1
  290. 15340  SC(27)=&H7B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
  291. 15350  X=1:GOSUB 25370:GOSUB 16930:IF ESC OR L<=0 THEN 15550
  292. 15360  X=4:GOSUB 25370:MID$(XD$,34)="+":GOSUB 17540
  293. 15370  MID$(XD$,34)=" ":IF ESC THEN 15550
  294. 15380  X=2:GOSUB 25370:GOSUB 17060:IF ESC THEN 15550
  295. 15390  X=3:GOSUB 25370:GOSUB 17430:IF ESC THEN 15550
  296. 15400  X=5:GOSUB 25370:GOSUB 17830:IF ESC THEN 15550
  297. 15410  X=6:GOSUB 25370:GOSUB 17930:IF ESC THEN 15550
  298. 15420  X=7:GOSUB 25370:GOSUB 18030:IF ESC THEN 15550
  299. 15430  X=8:GOSUB 25370:GOSUB 18330:IF ESC THEN 15550
  300. 15440  LSET XR$(XA)=XD$:XC=XC+1:IF XA=XT+1 THEN XT=XA
  301. 15450  GOSUB 16370:IF TC=0 THEN 15470
  302. 15460  GOSUB 27110:IF TC=0 THEN MID$(XR$(XA),35,2)=MKI$(0):X=4:GOSUB 25320
  303. 15470  GOSUB 26440:X=1:F=0:RETURN
  304. 15550  IF XF<=0 OR (X2>X3 AND X5=0) THEN LSET XD$=XR$(0):GOTO 15590
  305. 15560  H1=X2:H2=19:G1=1:G2=80:Z=0:L=1:IF H1=H2 THEN 15580
  306. 15570  SC(27)=&H6B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
  307. 15580  Y=X3:LSET XD$=XR$(X6)
  308. 15590  GOSUB 25180:X=2:F=0:RETURN
  309. 16370  IF XF>0 THEN 16420
  310. 16390  XF=XA:XN(XA)=XA:XL(XA)=XA:X4=XA:X6=XA:X5=XA:X2=X1:X3=X1:RETURN
  311. 16420  IF X2=X1 AND X5=XF THEN XF=XA:GOTO 16450
  312. 16430  IF X2>X3 AND X5=0 THEN 16480
  313. 16450  XN(XA)=X5:XL(XA)=XL(X5):XN(XL(X5))=XA:XL(X5)=XA:IF X4=X5 THEN X4=XA
  314. 16460  X5=XA:IF X3>=19 THEN X6=XL(X6):RETURN ELSE X3=X3+1:RETURN
  315. 16480  XN(XA)=XF:XL(XA)=XL(XF):XN(XL(XF))=XA:XL(XF)=XA
  316. 16490  X6=XA:X5=XA:X3=X2:RETURN
  317. 16570  IF X5>0 OR X2<=X3 THEN 16610
  318. 16580  LOCATE 25,1:COLOR 23,0:PRINT"Can only Add or Re-insert here.";
  319. 16590  COLOR 7,0:BEEP:OK=0:RETURN
  320. 16610  ON X GOSUB 16930,17060,17430,17540,17830,17930,18030,18330
  321. 16620  IF ESC THEN F=0:RETURN ELSE IF X<>2 THEN 16650
  322. 16630  IF RIGHT$(W$,4)<>".SMP" THEN F=0:RETURN
  323. 16640  TC=CVI(MID$(XD$,35,2)):IF TC<>0 THEN 16660
  324. 16650  LSET XR$(X5)=XD$:F=0:RETURN
  325. 16660  GOSUB 29730:J=1:MID$(W$,1)=SPACE$(14)
  326. 16670  K=LEN(W$)-4-L:MID$(W$,K)="D":IF TC>0 THEN MID$(W$,K)="W"
  327. 16680  IF MID$(D$,12,1)<"A" THEN 16710
  328. 16690  K=K-2:MID$(W$,K)=MID$(D$,12,1):MID$(W$,K+1)=":"
  329. 16700  MID$(W$,1)=MID$(D$,12,1):MID$(W$,2)=":":J=J+2
  330. 16710  L=J:J=29:MID$(W$,L)="D":IF TC>0 THEN MID$(W$,L)="W":L=L+1 ELSE L=L+1
  331. 16720  IF MID$(XR$(X5),J,1)=" " THEN J=J+1:GOTO 16720
  332. 16730  MID$(W$,L)=MID$(XR$(X5),J,35-J):L=L+35-J:MID$(W$,L)=".SMP":L=L+3
  333. 16790  ON ERROR GOTO 16820
  334. 16800  NAME LEFT$(W$,L) AS RIGHT$(W$,LEN(W$)-K+1)
  335. 16810  ON ERROR GOTO 29930:GOTO 16890
  336. 16820  IF ERR=53 THEN RESUME 16860
  337. 16830  IF ERR=58 THEN RESUME 16890
  338. 16840  IF ERR=71 THEN RESUME 16850 ELSE 29930
  339. 16850  GOSUB 29140:GOTO 16790
  340. 16860  LOCATE 25,1:COLOR 23,0:PRINT"Price history file not found.";
  341. 16870  COLOR 7,0:BEEP:OK=0:MID$(XD$,35,2)=MKI$(0):X=4:GOSUB 25320:X=2
  342. 16880  MID$(XR$(X5),35,2)=MKI$(0):GOSUB 26440:F=0:RETURN
  343. 16890  LSET XR$(X5)=XD$:GOSUB 26440:F=0:RETURN
  344. 16930  GOSUB 29730:LOCATE 21,1
  345. 16940  PRINT"Enter the name of the stock (or other security):";
  346. 16950  Q=24:GOSUB 28810:IF ESC OR L<=0 THEN 16990
  347. 16960  MID$(XD$,5)=SPACE$(24):MID$(XD$,5)=LEFT$(W$,L)
  348. 16990  GOSUB 25320:RETURN
  349. 17060  GOSUB 29730:LOCATE 21,1:MID$(W$,LEN(W$)-9)=SPACE$(10)
  350. 17070  PRINT"Only a hyphen (-), underline (_) or plus";
  351. 17080  PRINT" sign (+) and the letters A through Z"
  352. 17090  PRINT"and digits 0 through 9 are allowed in th";
  353. 17100  PRINT"e ticker symbol; and the first charac-"
  354. 17110  PRINT"ter must be a letter A-Z.  Valid example";
  355. 17120  PRINT"s include: T, PZL_B, IBM+P, AGREA."
  356. 17130  PRINT"Enter the symbol here:";
  357. 17140  LOCATE 24,23:Q=6:GOSUB 28810
  358. 17150  IF ESC THEN GOSUB 25320:RETURN ELSE IF L>0 THEN 17180
  359. 17160  IF MID$(XD$,29,6)<>"      " THEN GOSUB 25320:RETURN
  360. 17170  GOSUB 29870:GOSUB 28830:GOTO 17150
  361. 17180  IF MID$(W$,L,1)=" " THEN G=G-1:L=L-1:P=P-1:GOTO 17180 ELSE K=L
  362. 17190  IF MID$(W$,K,1)>="A" AND MID$(W$,K,1)<="Z" THEN 17230
  363. 17200  IF K=1 THEN 17360 ELSE IF MID$(W$,K,1)="+" THEN 17230
  364. 17210  IF MID$(W$,K,1)="-" OR MID$(W$,K,1)="_" THEN 17230
  365. 17220  IF MID$(W$,K,1)<"0" OR MID$(W$,K,1)>"9" THEN 17360
  366. 17230  IF K>1 THEN K=K-1:GOTO 17190
  367. 17240  MID$(W$,LEN(W$)-9)="      .SMP":MID$(W$,LEN(W$)-3-L)=LEFT$(W$,L)
  368. 17250  FOR J=1 TO XT
  369. 17260  IF MID$(W$,LEN(W$)-9,6)<>MID$(XR$(J),29,6) THEN 17300
  370. 17270  IF XN(J)=0 AND XL(J)=0 AND J<>XE THEN 17300
  371. 17280  T=CVI(MID$(XR$(J),35,2)):IF T=0 THEN J=XT+2:GOTO 17300
  372. 17290  IF SGN(T)=SGN(TC) THEN J=XT+2
  373. 17300  NEXT J:IF J>XT+1 THEN MID$(W$,LEN(W$)-9)=SPACE$(10):GOTO 17380
  374. 17310  MID$(XD$,29)=MID$(W$,LEN(W$)-9,6):GOSUB 25320:RETURN
  375. 17360  LOCATE 25,1:COLOR 23,0:PRINT"Invalid characters in ticker symbol.";
  376. 17370  COLOR 7,0:BEEP:OK=0:GOSUB 28830:GOTO 17150
  377. 17380  LOCATE 25,1:COLOR 23,0:PRINT"This ticker symbol already exists.";
  378. 17390  COLOR 7,0:BEEP:OK=0:GOSUB 28830:GOTO 17150
  379. 17430  GOSUB 29730:LOCATE 21,1
  380. 17440  PRINT"Enter the exchange (NYSE, AMEX, OTC, etc.):";
  381. 17450  Q=4:GOSUB 28810
  382. 17460  IF ESC THEN GOSUB 25320:RETURN ELSE IF L>0 THEN 17490
  383. 17470  IF MID$(XD$,1,1)>" " THEN GOSUB 25320:RETURN
  384. 17480  GOSUB 29870:GOSUB 28830:GOTO 17460
  385. 17490  MID$(XD$,1)=SPACE$(4):MID$(XD$,1)=LEFT$(W$,L):GOSUB 25320:RETURN
  386. 17540  GOSUB 29730:LOCATE 21,1
  387. 17550  PRINT"Do you want to enter prices daily, for this stock only"
  388. 17560  PRINT"If not, the program assumes you want to enter data weekly."
  389. 17570  PRINT"Warning:  Once entered, this parameter cannot be changed!";
  390. 17580  LOCATE 21,55:GOSUB 29550:IF ESC THEN RETURN
  391. 17590  H1=21:H2=22:G1=1:G2=80:GOSUB 29740:LOCATE 21,1
  392. 17610  PRINT"Prices can be kept for at least 5, but n";
  393. 17620  PRINT"ot more than";TM;"days (weekends are not"
  394. 17630  PRINT"counted) or weeks.  For how many periods";
  395. 17640  PRINT" do you want price data?";
  396. 17650  LOCATE 22,65:R=0:WL!=5:WH!=CSNG(TM):GOSUB 28460:IF ESC THEN RETURN
  397. 17660  IF L<=0 THEN GOSUB 29870:GOTO 17650
  398. 17670  TC=CINT(W!):IF YES THEN TC=-(TC)
  399. 17680  MID$(XD$,35,2)=MKI$(TC):GOSUB 25620
  400. 17690  RETURN
  401. 17830  GOSUB 29730:LOCATE 21,1
  402. 17840  PRINT"Enter the annual earnings per share (or other unit):";
  403. 17850  R=1:WL!=-49.99:WH!=49.99:GOSUB 28460
  404. 17860  IF NOT ESC AND L>0 THEN MID$(XD$,41)=MKI$(CINT(W!*100))
  405. 17890  GOSUB 25320:RETURN
  406. 17930  GOSUB 29730:LOCATE 21,1
  407. 17940  PRINT"Enter the annual dividend or interest per unit:";
  408. 17950  R=1:WL!=0:WH!=49.99:GOSUB 28460
  409. 17960  IF NOT ESC AND L>0 THEN MID$(XD$,39)=MKI$(CINT(W!*100))
  410. 17990  GOSUB 25320:RETURN
  411. 18030  GOSUB 29730:MID$(W$,LEN(W$)-3)=MID$(XD$,45,4):LOCATE 21,1
  412. 18040  PRINT"What are the low and high estimates for ";
  413. 18050  PRINT"the 3-5 year price goal for this stock?"
  414. 18060  PRINT"Each estimate is to be entered separatel";
  415. 18070  PRINT"y as a whole number between 0 and 999."
  416. 18080  PRINT"Enter zero where either or both of the p";
  417. 18090  PRINT"rice goals are not known or don't apply.";
  418. 18110  LOCATE 24,1:PRINT"Enter the LOWEST estimate first:";
  419. 18120  R=0:WL!=0:WH!=999:GOSUB 28460:IF ESC THEN 18270 ELSE IF L<=0 THEN 18210
  420. 18130  MID$(XD$,45,2)=MKI$(CINT(W!*32))
  421. 18140  IF CINT(W!*32)>CVI(MID$(XD$,47,2)) THEN MID$(XD$,47)=MID$(XD$,45,2)
  422. 18150  GOSUB 25370
  423. 18210  LOCATE 24,1:PRINT"Enter the HIGHEST estimate next:";
  424. 18220  R=0:WL!=0:WH!=999:GOSUB 28460:IF ESC THEN 18270
  425. 18230  IF L>0 THEN MID$(XD$,47,2)=MKI$(CINT(W!*32))
  426. 18240  WL!=CSNG(CVI(MID$(XD$,45,2))):WH!=CSNG(CVI(MID$(XD$,47,2)))
  427. 18250  IF WL!<=WH! THEN GOSUB 25320:RETURN ELSE GOSUB 25370:GOTO 18280
  428. 18270  MID$(XD$,45)=RIGHT$(W$,4):GOSUB 25320:RETURN
  429. 18280  LOCATE 25,1:COLOR 23,0:PRINT"Low exceeds high value, try again.";
  430. 18290  COLOR 7,0:OK=0:BEEP:GOTO 18110
  431. 18330  GOSUB 29730:LOCATE 21,1
  432. 18340  PRINT"Enter the stop (or other) limit price:";
  433. 18350  R=1:WL!=-999.9:WH!=999.9:GOSUB 28460
  434. 18360  IF NOT ESC AND L>0 THEN MID$(XD$,43)=MKI$(CINT(W!*32))
  435. 18390  GOSUB 25320:RETURN
  436. 24040  IF X<1 OR X>=8 THEN GOSUB 29850:GOTO 24090
  437. 24050  IF X<>3 THEN X=X+1 ELSE X=5
  438. 24090  RETURN
  439. 24140  IF X<=1 OR X>8 THEN GOSUB 29850:GOTO 24190
  440. 24150  IF X<>5 THEN X=X-1 ELSE X=3
  441. 24190  RETURN
  442. 24310  IF X2>X1 AND X2<=X3 THEN X2=X2-1:X5=XL(X5):RETURN
  443. 24320  IF X2=X3+1 THEN X5=X6:IF X4=XF THEN X2=X3:RETURN ELSE 24350
  444. 24330  IF X2=X1 AND X4<>XF THEN 24360 ELSE GOSUB 29850:RETURN
  445. 24350  X3=X3+1:X4=XL(X4):GOTO 24370
  446. 24360  X4=XL(X4):X5=X4:X6=XL(X6)
  447. 24370  H1=X1:H2=X3:G1=1:G2=80:Z=0:L=1
  448. 24380  SC(27)=&H7B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
  449. 24390  LSET XD$=XR$(X4):Y=X1:GOSUB 25180:RETURN
  450. 24510  IF X2>=X1 AND X2<X3 THEN X2=X2+1:X5=XN(X5):RETURN
  451. 24520  IF X2<>X3 THEN GOSUB 29850:RETURN
  452. 24530  IF X3<19 THEN X5=0:X2=X2+1:RETURN
  453. 24560  H1=X1:H2=X3:G1=1:G2=80:Z=0:L=1
  454. 24570  SC(27)=&H6B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
  455. 24580  X4=XN(X4):IF XN(X5)=XF THEN X5=0:X3=X3-1:RETURN
  456. 24590  X6=XN(X6):X5=X6:LSET XD$=XR$(X5):Y=X2:GOSUB 25180:RETURN
  457. 24640  J=0:IF X4=XF THEN 24680
  458. 24650  X4=XL(X4):J=J+1:IF J<10 AND X4<>XF THEN 24650
  459. 24660  GOSUB 25050:GOTO 24690
  460. 24680  IF X2<=X1 THEN GOSUB 29850:RETURN
  461. 24690  X5=X4:X2=X1:RETURN
  462. 24740  J=0:IF XN(X6)=XF THEN 24780
  463. 24750  X6=XN(X6):X4=XN(X4):J=J+1:IF J<10 AND X6<>XL(XF) THEN 24750
  464. 24760  GOSUB 25050:GOTO 24790
  465. 24780  IF X2>=X3 THEN GOSUB 29850:RETURN
  466. 24790  X5=X6:X2=X3:RETURN
  467. 24830  IF X4=XF THEN 24880
  468. 24840  X4=XF:GOSUB 25050:GOTO 24890
  469. 24880  IF X5=XF AND X2=X1 THEN GOSUB 29850:RETURN
  470. 24890  X5=XF:X2=X1:RETURN
  471. 24930  IF XN(X6)=XF THEN 24980
  472. 24940  X4=XL(XF):X2=X1
  473. 24950  IF X4=XF OR X2>=19 THEN GOSUB 25050:GOTO 24990
  474. 24960  X4=XL(X4):X2=X2+1:GOTO 24950
  475. 24980  IF X5<=0 OR XN(X5)=XF THEN GOSUB 29850:RETURN
  476. 24990  X5=XL(XF):X2=X3:RETURN
  477. 25050  X3=X1:X6=X4:IF XF<=0 THEN 25090
  478. 25060  LSET XD$=XR$(X6):Y=X3:GOSUB 25180
  479. 25070  IF XN(X6)=XF OR X3>=19 THEN 25090
  480. 25080  X6=XN(X6):X3=X3+1:GOTO 25060
  481. 25090  RETURN
  482. 25180  GOSUB 25420:GOSUB 25470:GOSUB 25520:GOSUB 25620
  483. 25190  GOSUB 25720:GOSUB 25770:GOSUB 25820:GOSUB 25920:RETURN
  484. 25240  CLS:X1=0
  485. 25250  X1=X1+1:PRINT" ADD/DELETE STOCKS - VERSION 2.1";
  486. 25260  LOCATE X1,42:PRINT" NO. OF      ANNUAL     3-5 YR.   STOP"
  487. 25270  X1=X1+1:PRINT" NAME OF STOCK             SYMBOL(EXCH)";
  488. 25280  LOCATE X1,42:PRINT"DAYS/WKS  EARNS. DIVID. PR.GOAL  LIMIT";
  489. 25290  X1=X1+2:RETURN
  490. 25320  ON X GOTO 25420,25470,25520,25620,25720,25770,25820,25920
  491. 25360  Y=X2:LSET XD$=XR$(X5)
  492. 25370  COLOR 0,7
  493. 25380  ON X GOSUB 25420,25470,25520,25620,25720,25770,25820,25920
  494. 25390  COLOR 7,0:RETURN
  495. 25420  LOCATE Y,1:PRINT" ";MID$(XD$,5,24);" ";:RETURN
  496. 25470  LOCATE Y,26:PRINT" ";MID$(XD$,29,6);" ";:RETURN
  497. 25520  LOCATE Y,33:L=1:IF MID$(XD$,1,1)=" " THEN PRINT SPACE$(8);:RETURN
  498. 25530  L=L+1:IF L<=4 AND MID$(XD$,L,1)<>" " THEN 25530
  499. 25540  PRINT" (";MID$(XD$,1,L-1);")";SPACE$(6-L);:RETURN
  500. 25620  LOCATE Y,41:IF MID$(XD$,34,1)<=" " THEN PRINT SPACE$(10);:RETURN
  501. 25630  TC=CVI(MID$(XD$,35,2)):IF TC=0 THEN PRINT"   NONE   ";:RETURN
  502. 25640  PRINT USING"###";ABS(TC);
  503. 25650  IF TC<0 THEN PRINT" DAYS  ";:RETURN ELSE PRINT" WEEKS ";:RETURN
  504. 25720  LOCATE Y,51:IF MID$(XD$,34,1)<=" " THEN PRINT SPACE$(7);:RETURN
  505. 25730  PRINT USING"###.## ";CSNG(CVI(MID$(XD$,41,2)))/100;:RETURN
  506. 25770  LOCATE Y,58:IF MID$(XD$,34,1)<=" " THEN PRINT SPACE$(7);:RETURN
  507. 25780  PRINT USING"###.## ";CSNG(CVI(MID$(XD$,39,2)))/100;:RETURN
  508. 25820  LOCATE Y,65:IF MID$(XD$,34,1)<=" " THEN PRINT SPACE$(9);:RETURN
  509. 25830  W=CINT(CSNG(CVI(MID$(XD$,45,2)))/32)
  510. 25840  PRINT USING"####";W;:MID$(W$,1)=SPACE$(5)
  511. 25850  W=CINT(CSNG(CVI(MID$(XD$,47,2)))/32)
  512. 25860  MID$(W$,1)=STR$(W):MID$(W$,1)="-"
  513. 25870  PRINT LEFT$(W$,5);:RETURN
  514. 25920  LOCATE Y,74:IF MID$(XD$,34,1)<=" " THEN 25990
  515. 25930  W!=CSNG(CVI(MID$(XD$,43,2)))/32
  516. 25940  IF ABS(W!)<9.9995 THEN PRINT USING"##.### ";W!;:RETURN
  517. 25950  IF ABS(W!)<99.995 THEN PRINT USING"###.## ";W!;:RETURN
  518. 25960  IF ABS(W!)<999.95 THEN PRINT USING"####.# ";W!;:RETURN
  519. 25990  PRINT SPACE$(7);:RETURN
  520. 26240  IF XE<=0 THEN 26440
  521. 26250  TC=CVI(MID$(XR$(XE),35,2)):IF TC=0 THEN 26440
  522. 26260  MID$(W$,1)=SPACE$(14):L=1
  523. 26270  IF MID$(D$,12,1)>="A" THEN MID$(W$,1)=MID$(D$,12,1):MID$(W$,2)=":":L=3
  524. 26280  K=29:MID$(W$,L)="D":L=L+1:IF TC>0 THEN MID$(W$,L-1)="W"
  525. 26290  IF MID$(XR$(XE),K,1)=" " THEN K=K+1:GOTO 26290
  526. 26300  MID$(W$,L)=MID$(XR$(XE),K,35-K):L=L+35-K:MID$(W$,L)=".SMP":L=L+3
  527. 26340  ON ERROR GOTO 26360
  528. 26350  KILL LEFT$(W$,L):GOTO 26380
  529. 26360  IF ERR=71 THEN RESUME 26390
  530. 26370  IF ERR=53 THEN RESUME 26380 ELSE 29930
  531. 26380  ON ERROR GOTO 29930:XE=0:GOTO 26440
  532. 26390  GOSUB 29140:GOTO 26340
  533. 26440  GOSUB 26830:IF ESC THEN 26440
  534. 26450  MID$(XD$,1,4)="SMX2":MID$(XD$,5,2)=MKI$(64)
  535. 26460  MID$(XD$,7,2)=MKI$(XM):MID$(XD$,9,2)=MKI$(XC)
  536. 26470  FOR K=11 TO 63 STEP 2:MID$(XD$,K,2)=MKI$(0):NEXT K:K=0
  537. 26480  LSET XB$=XD$:PUT#2:XP=XF:IF XP<=0 THEN 26580
  538. 26490  H1=X4:H2=X5:IF X5>0 OR X2<=X3 THEN 26510
  539. 26500  H2=X6:IF X4<>XF THEN H1=XL(X4)
  540. 26510  LSET XB$=XR$(XP):PUT#2:K=K+1
  541. 26520  IF XP=H1 THEN MID$(XD$,11,2)=MKI$(K)
  542. 26530  IF XP=H2 THEN MID$(XD$,13,2)=MKI$(K)
  543. 26540  XP=XN(XP):IF XP<>XF THEN 26510
  544. 26550  LSET XB$=XD$:PUT#2,1:LSET XD$=XR$(X5):GOTO 26590
  545. 26580  LSET XB$=XR$(0):FOR J=1 TO XM:PUT#2:NEXT J
  546. 26590  CLOSE#2:RETURN
  547. 26640  GOSUB 26830:IF ESC THEN RETURN
  548. 26650  IF LOF(2)<=0 THEN XC=-1:CLOSE#2:KILL LEFT$(W$,L):RETURN
  549. 26660  GET#2:V2=0:IF MID$(XB$,1,4)="SMX2" THEN V2=-1:GOTO 26710
  550. 26670  XC=CVI(MID$(XB$,3,2)):IF XC>0 THEN X4=1:X5=1:GOTO 26740
  551. 26680  X4=0:X5=0:CLOSE#2:RETURN
  552. 26710  XC=CVI(MID$(XB$,9,2))
  553. 26720  X4=CVI(MID$(XB$,11,2)):X5=CVI(MID$(XB$,13,2))
  554. 26730  IF XC<=0 THEN CLOSE#2:RETURN
  555. 26740  FOR J=1 TO XC
  556. 26750  GET#2:LSET XR$(J)=XB$:XN(J)=J+1:XL(J)=J-1:IF V2 THEN 26790
  557. 26760  W!=CVS(MID$(XB$,37,4)):MID$(XR$(J),39)=MKI$(CINT(W!*100))
  558. 26770  W!=CVS(MID$(XB$,41,4)):MID$(XR$(J),41)=MKI$(CINT(W!*100))
  559. 26780  MID$(XR$(J),37)=MKI$(0):MID$(XR$(J),43)=MKI$(0)
  560. 26790  NEXT J:XN(XC)=1:XL(1)=XC:CLOSE#2:RETURN
  561. 26830  MID$(W$,1)=SPACE$(80):L=1:IF MID$(D$,12,1)<"A" THEN 26850
  562. 26840  MID$(W$,1)=MID$(D$,12,1):MID$(W$,2)=":":L=3
  563. 26850  MID$(W$,L)="INDEXFIL.SMX":L=L+11:ESC=0
  564. 26950  ON ERROR GOTO 26980
  565. 26960  OPEN LEFT$(W$,L) AS #2 LEN=64:ON ERROR GOTO 29930
  566. 26970  FIELD#2,64 AS XB$:RETURN
  567. 26980  IF ERR=71 THEN RESUME 26990 ELSE 29930
  568. 26990  GOSUB 29140:IF ESC THEN RETURN ELSE 26950
  569. 27110  IF TC=0 THEN RETURN
  570. 27120  BJ=DJ:BY=DY:BW=DW:IF TC>1 THEN 27210
  571. 27130  IF BW>5 THEN BJ=BJ-BW+5:GOTO 27150
  572. 27140  IF BW=1 THEN BJ=BJ-3 ELSE BJ=BJ-1
  573. 27150  BJ=BJ-(ABS(TC)\5)*7-(ABS(TC) MOD 5)
  574. 27160  IF BJ<=0 THEN BY=BY-1:BJ=BJ+365+ABS(BY MOD 4 = 0):GOTO 27160
  575. 27170  BW=(INT((BY-1)*365.25)+BJ+5) MOD 7:IF BW=0 THEN BW=7
  576. 27180  IF BW<=5 THEN 27240 ELSE BJ=BJ-BW+5:BW=5
  577. 27190  IF BJ<=0 THEN BY=BY-1:BJ=BJ+365+ABS(BY MOD 4 = 0)
  578. 27200  GOTO 27240
  579. 27210  IF BW>5 THEN BJ=BJ-BW+5 ELSE BJ=BJ-BW-2
  580. 27220  BW=5:BJ=BJ-TC*7
  581. 27230  IF BJ<=0 THEN BY=BY-1:BJ=BJ+365+ABS(BY MOD 4 = 0):GOTO 27230
  582. 27240  MID$(W$,1)=SPACE$(14):L=1
  583. 27250  IF MID$(D$,12,1)>="A" THEN MID$(W$,1)=MID$(D$,12,1):MID$(W$,2)=":":L=3
  584. 27260  K=29:MID$(W$,L)="D":L=L+1:IF TC>0 THEN MID$(W$,L-1)="W"
  585. 27270  IF MID$(XD$,K,1)=" " THEN K=K+1:GOTO 27270
  586. 27280  MID$(W$,L)=MID$(XD$,K,35-K):L=L+35-K:MID$(W$,L)=".SMP":L=L+3
  587. 27310  GOSUB 29730:LOCATE 21,1
  588. 27320  PRINT"Initializing volume and price data, one moment please ...";
  589. 27330  J=0:ON ERROR GOTO 27470
  590. 27340  OPEN LEFT$(W$,L) AS #3 LEN=32:FIELD#3,32 AS PB$
  591. 27350  MID$(PD$,1)="SMP2":MID$(PD$,5)=MKI$(32):MID$(PD$,7)=MKI$(ABS(TC))
  592. 27360  MID$(PD$,9)=MKI$(ABS(TC)):IF TC<0 THEN TN=1 ELSE TN=7
  593. 27370  MID$(PD$,11)=MKI$(TN):MID$(PD$,13)=MKI$(ABS(TC))
  594. 27380  FOR K=15 TO 31 STEP 2:MID$(PD$,K)=MKI$(0):NEXT K:LSET PB$=PD$:PUT#3
  595. 27390  FOR K=5 TO 15 STEP 2:MID$(PD$,K)=MKI$(0):NEXT K
  596. 27400  EJ=BJ:EY=BY:EW=BW:T=365+ABS(EY MOD 4 = 0)
  597. 27410  FOR J=1 TO ABS(TC)
  598. 27420  EJ=EJ+TN:IF TN<>1 THEN 27440
  599. 27430  EW=EW+1:IF EW>5 THEN EJ=EJ+2:EW=1
  600. 27440  IF EJ>T THEN EJ=EJ-T:EY=EY+1:T=365+ABS(EY MOD 4 = 0)
  601. 27450  MID$(PD$,1)=MKS$(CSNG(EY*1000+EJ)):LSET PB$=PD$:PUT#3
  602. 27460  NEXT J:CLOSE#3:ON ERROR GOTO 29930:RETURN
  603. 27470  IF ERR=71 THEN RESUME 27580
  604. 27480  IF ERR=67 THEN RESUME 27520
  605. 27490  IF ERR=61 THEN RESUME 27510 ELSE 29930
  606. 27510  LOCATE 21,1:PRINT"The data disk has no more space!";:GOTO 27530
  607. 27520  LOCATE 21,1:PRINT"The data disk directory is full!";
  608. 27530  PRINT"  In order to add another stock, it"
  609. 27540  PRINT"will be necessary to either delete an ex";
  610. 27550  PRINT"isting stock or start a new data disk.";
  611. 27560  IF J>0 THEN CLOSE#3:KILL LEFT$(W$,L)
  612. 27570  TC=0:GOSUB 29230:RETURN
  613. 27580  IF J>0 THEN CLOSE#3
  614. 27590  GOSUB 29730:GOSUB 29140:GOTO 27310
  615. 28460  Q=6:GOSUB 28810
  616. 28470  K=1:IF ESC OR L<=0 THEN RETURN
  617. 28480  IF LEFT$(W$,1)<>"-" AND LEFT$(W$,1)<>"+" THEN 28510
  618. 28490  K=2:IF K>L THEN 28680
  619. 28510  IF MID$(W$,K,1)="." THEN 28540
  620. 28520  IF MID$(W$,K,1)<"0" OR MID$(W$,K,1)>"9" THEN 28680
  621. 28530  K=K+1:IF K<=L THEN 28510 ELSE 28630
  622. 28540  K=K+1:IF K>L THEN 28680
  623. 28550  IF MID$(W$,K,1)<"0" OR MID$(W$,K,1)>"9" THEN 28680
  624. 28560  K=K+1:IF K<=L THEN 28550
  625. 28630  W!=VAL(LEFT$(W$,L))
  626. 28640  IF R=0 AND INT(W!)<>W! THEN 28670
  627. 28650  IF W!>=WL! AND W!<=WH! THEN RETURN
  628. 28660  LOCATE 25,1:COLOR 23,0:PRINT"Too big or too small";:GOTO 28690
  629. 28670  LOCATE 25,1:COLOR 23,0:PRINT"Whole number only";:GOTO 28690
  630. 28680  LOCATE 25,1:COLOR 23,0:PRINT"Improper numeric entry";
  631. 28690  COLOR 7,0:BEEP:OK=0:GOSUB 28830:GOTO 28470
  632. 28810  H=CSRLIN:G=POS(0)+1:MID$(W$,1)=SPACE$(Q)
  633. 28820  COLOR 0,7:PRINT SPACE$(Q+2);:COLOR 7,0:P=1
  634. 28830  LOCATE H,G,1:GOSUB 29660:LOCATE H,G,0:IF ESC THEN L=-1:RETURN
  635. 28840  IF LEFT$(C$,1)=CHR$(13) THEN L=P-1:RETURN
  636. 28850  IF LEFT$(C$,1)=CHR$(8) THEN 28940
  637. 28860  IF LEFT$(C$,1)=CHR$(32) THEN IF P>1 THEN 28910 ELSE 28980
  638. 28870  IF LEFT$(C$,1)<CHR$(32) THEN GOSUB 29830:GOTO 28830
  639. 28880  IF LEFT$(C$,1)>CHR$(127) THEN GOSUB 29830:GOTO 28830
  640. 28890  IF LEFT$(C$,1)>=CHR$(96) THEN MID$(C$,1,1)=CHR$(ASC(LEFT$(C$,1))-32)
  641. 28910  IF P>Q THEN GOSUB 29850:GOTO 28830
  642. 28920  MID$(W$,P,1)=LEFT$(C$,1):G=G+1:P=P+1
  643. 28930  COLOR 0,7:PRINT LEFT$(C$,1);:COLOR 7,0:GOTO 28830
  644. 28940  IF P<=1 THEN GOSUB 29850:GOTO 28830
  645. 28950  G=G-1:P=P-1:MID$(W$,P,1)=" "
  646. 28960  LOCATE H,G:COLOR 0,7:PRINT" ";:COLOR 7,0:GOTO 28830
  647. 28980  LOCATE 25,1:COLOR 23,0:PRINT"First character cannot be a space.";
  648. 28990  COLOR 7,0:BEEP:OK=0:GOTO 28830
  649. 29040  LOCATE 22,1:PRINT SPACE$(80);:IF MID$(D$,12,1)=" " THEN 29180
  650. 29050  PRINT"Insert the correct PROGRAM diskette";:GOTO 29190
  651. 29140  LOCATE 22,1:PRINT SPACE$(80);:IF MID$(D$,12,1)=" " THEN 29180
  652. 29150  PRINT"Insert the correct DATA diskette";
  653. 29160  IF MID$(D$,12,1)<"A" THEN 29190
  654. 29170  PRINT " in drive ";MID$(D$,12,1);" and close the door.";:GOTO 29230
  655. 29180  PRINT"Make sure the correct diskette is";
  656. 29190  PRINT" in the system drive and close the door.";
  657. 29230  LOCATE 24,1:BEEP
  658. 29240  PRINT"Press ENTER or Esc to continue.";
  659. 29250  H=CSRLIN:G=POS(0)
  660. 29260  LOCATE H,G,1:GOSUB 29650
  661. 29270  IF ESC OR LEFT$(C$,1)=CHR$(13) THEN 29290
  662. 29280  GOSUB 29830:GOTO 29260
  663. 29290  H1=23:H2=24:G1=1:G2=80:GOSUB 29740:RETURN
  664. 29550  PRINT" (Y=Yes, N=No)? ";:H=CSRLIN:G=POS(0)
  665. 29560  LOCATE H,G,1:GOSUB 29650:LOCATE H,G:IF ESC THEN RETURN
  666. 29570  IF LEFT$(C$,1)="n" OR LEFT$(C$,1)="N" THEN PRINT"N";:YES=0:RETURN
  667. 29580  IF LEFT$(C$,1)="y" OR LEFT$(C$,1)="Y" THEN PRINT"Y";:YES=-1:RETURN
  668. 29590  GOSUB 29830:GOTO 29560
  669. 29650  MID$(C$,1)=Z$:MID$(C$,1)=INKEY$:IF C$<>Z$ THEN 29650
  670. 29660  MID$(C$,1)=Z$:MID$(C$,1)=INKEY$:IF C$=Z$ THEN 29660
  671. 29670  ESC=0:IF LEFT$(C$,1)=CHR$(27) THEN ESC=-1
  672. 29680  LOCATE ,,0:IF OK THEN RETURN
  673. 29690  LOCATE 25,1:PRINT SPACE$(36);:OK=-1:RETURN
  674. 29730  H1=21:H2=24:G1=1:G2=80
  675. 29740  DEF SEG:AD=VARPTR(BS(1)):CALL AD(H1,G1,H2,G2):RETURN
  676. 29830  LOCATE 25,1:COLOR 23,0:PRINT"Wrong key pressed, try again.";
  677. 29840  COLOR 7,0:OK=0:BEEP:RETURN
  678. 29850  LOCATE 25,1:COLOR 23,0:PRINT"Can't move any farther.";
  679. 29860  COLOR 7,0:OK=0:BEEP:RETURN
  680. 29870  LOCATE 25,1:COLOR 23,0:PRINT"Data must be entered.";
  681. 29880  COLOR 7,0:OK=0:BEEP:RETURN
  682. 29910  LOCATE 25,1:COLOR 23,0:PRINT"Function not available.";
  683. 29920  COLOR 7,0:OK=0:BEEP:RETURN
  684. 29930  LOCATE 19,1,0:PRINT SPACE$(80);
  685. 29940  PRINT"PROGRAM ABORTED DUE TO A FATAL ERROR.  F";
  686. 29950  PRINT"urther explanation of the following     ";
  687. 29960  PRINT"error message may be found in Appendix A";
  688. 29970  PRINT" of the IBM or Compaq BASIC manual.     ";
  689. 29980  PRINT SPACE$(239);:LOCATE 22,1,1:BEEP:ON ERROR GOTO 0
  690. 29990  END
  691.